library("FRESA.CAD")
library(readxl)
library(igraph)
library(umap)
library(tsne)
library(entropy)
op <- par(no.readonly = TRUE)
pander::panderOptions('digits', 3)
pander::panderOptions('table.split.table', 400)
pander::panderOptions('keep.trailing.zeros',TRUE)
About Dataset This dataset is a copy of another Kaggle dataset which can be accessed here: https://www.kaggle.com/c/glioma-radiomics The difference is that I have provided ground truth for the test set (test_GT.csv).
The suffix “omics” in Medical Science is associated with analysis of big sets of features (e.g. Genomics, Proteomics). Radiomics are imaging features (e.g., first order and second order) extracted from Regions of Interest (ROI) in radiology images based on predefined functions and filters. Low grade gliomas (LGG) are a type of brain tumors. Astrocytes and Oligodendrocytes which are two types of brain cells, are considered as origins of LGG. Adult LGG are characterized by different mutations which is important to be correctly identified. With this dataset the goal is to determine if an ROI has 1p19q codeletion (Mutacion=1) or not(Mutacion=0). This plays a key role in predicting patient’s response to chemotherapy and their survival. The dataset provides 640 different radiomics features for each ROI. There are 105 ROIs in the training set and 45 ROIs in the test cohort.
https://www.kaggle.com/datasets/knamdar/radiomics-for-lgg-dataset?select=test_GT.csv
LGG_Data <- read.csv("~/GitHub/LatentBiomarkers/Data/LGG/train.csv")
LGG_DataTest <- read.csv("~/GitHub/LatentBiomarkers/Data/LGG/test.csv")
LGG_TestGT <- read.csv("~/GitHub/LatentBiomarkers/Data/LGG/test_GT.csv")
LGG_DataTest$Mutacion <- LGG_TestGT$Mutacion
LGG_Data <- rbind(LGG_Data,LGG_DataTest)
rownames(LGG_Data) <- LGG_Data$patientID
LGG_Data$patientID <- NULL
pander::pander(table(LGG_Data$Mutacion))
| 0 | 1 |
|---|---|
| 54 | 96 |
studyName <- "LGG"
dataframe <- LGG_Data
outcome <- "Mutacion"
TopVariables <- 10
thro <- 0.80
cexheat = 0.15
Some libraries
library(psych)
library(whitening)
library("vioplot")
library("rpart")
pander::pander(c(rows=nrow(dataframe),col=ncol(dataframe)-1))
| rows | col |
|---|---|
| 150 | 640 |
pander::pander(table(dataframe[,outcome]))
| 0 | 1 |
|---|---|
| 54 | 96 |
varlist <- colnames(dataframe)
varlist <- varlist[varlist != outcome]
largeSet <- length(varlist) > 1500
Scaling and removing near zero variance columns and highly co-linear(r>0.99999) columns
### Some global cleaning
sdiszero <- apply(dataframe,2,sd) > 1.0e-16
dataframe <- dataframe[,sdiszero]
varlist <- colnames(dataframe)[colnames(dataframe) != outcome]
tokeep <- c(as.character(correlated_Remove(dataframe,varlist,thr=0.99999)),outcome)
dataframe <- dataframe[,tokeep]
varlist <- colnames(dataframe)
varlist <- varlist[varlist != outcome]
iscontinous <- sapply(apply(dataframe,2,unique),length) >= 5 ## Only variables with enough samples
dataframeScaled <- FRESAScale(dataframe,method="OrderLogit")$scaledData
numsub <- nrow(dataframe)
if (numsub > 1000) numsub <- 1000
if (!largeSet)
{
hm <- heatMaps(data=dataframeScaled[1:numsub,],
Outcome=outcome,
Scale=TRUE,
hCluster = "row",
xlab="Feature",
ylab="Sample",
srtCol=45,
srtRow=45,
cexCol=cexheat,
cexRow=cexheat
)
par(op)
}
The heat map of the data
if (!largeSet)
{
par(cex=0.6,cex.main=0.85,cex.axis=0.7)
#cormat <- Rfast::cora(as.matrix(dataframe[,varlist]),large=TRUE)
cormat <- cor(dataframe[,varlist],method="pearson")
cormat[is.na(cormat)] <- 0
gplots::heatmap.2(abs(cormat),
trace = "none",
# scale = "row",
mar = c(5,5),
col=rev(heat.colors(5)),
main = "Original Correlation",
cexRow = cexheat,
cexCol = cexheat,
srtCol=45,
srtRow=45,
key.title=NA,
key.xlab="|Pearson Correlation|",
xlab="Feature", ylab="Feature")
diag(cormat) <- 0
print(max(abs(cormat)))
}
[1]
0.9999991
DEdataframe <- IDeA(dataframe,verbose=TRUE,thr=thro)
#>
#> Included: 632 , Uni p: 0.0003949447 , Outcome-Driven Size: 0 , Base Size: 93 , Rcrit: 0.2711575
#>
#>
1 <R=1.000,thr=0.900,N= 509>, Top: 52( 2 )[ 1 : 52 Fa= 52 : 0.900 ]( 52 , 314 , 0 ),<|>Tot Used: 366 , Added: 314 , Zero Std: 0 , Max Cor: 1.000
#>
2 <R=1.000,thr=0.900,N= 509>, Top: 77( 2 )[ 1 : 77 Fa= 126 : 0.900 ]( 76 , 218 , 52 ),<|>Tot Used: 478 , Added: 218 , Zero Std: 0 , Max Cor: 1.000
#>
3 <R=1.000,thr=0.900,N= 509>, Top: 43( 1 )[ 1 : 43 Fa= 169 : 0.900 ]( 43 , 63 , 126 ),<|>Tot Used: 491 , Added: 63 , Zero Std: 0 , Max Cor: 1.000
#>
4 <R=1.000,thr=0.900,N= 509>, Top: 7( 1 )[ 1 : 7 Fa= 175 : 0.900 ]( 7 , 8 , 169 ),<|>Tot Used: 491 , Added: 8 , Zero Std: 0 , Max Cor: 1.000
#>
5 <R=1.000,thr=0.900,N= 509>, Top: 1( 1 )[ 1 : 1 Fa= 176 : 0.900 ]( 1 , 1 , 175 ),<|>Tot Used: 491 , Added: 1 , Zero Std: 0 , Max Cor: 0.900
#>
6 <R=0.900,thr=0.800,N= 254>, Top: 79( 1 )[ 1 : 79 Fa= 202 : 0.800 ]( 76 , 131 , 176 ),<|>Tot Used: 540 , Added: 131 , Zero Std: 0 , Max Cor: 0.996
#>
7 <R=0.996,thr=0.900,N= 30>, Top: 15( 1 )[ 1 : 15 Fa= 206 : 0.900 ]( 15 , 15 , 202 ),<|>Tot Used: 541 , Added: 15 , Zero Std: 0 , Max Cor: 0.919
#>
8 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
9 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
10 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
11 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
12 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
13 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
14 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
15 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
16 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
17 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
18 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
19 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
20 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
21 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
22 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
23 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
24 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
25 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
26 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
27 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
28 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
29 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
30 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
31 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
32 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
33 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
34 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
35 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
36 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
37 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
38 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.919
#>
39 <R=0.919,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.918
#>
40 <R=0.918,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.916
#>
41 <R=0.916,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.903
#>
42 <R=0.903,thr=0.900,N= 30>, Top: 1( 1 )[ 1 : 1 Fa= 206 : 0.900 ]( 1 , 1 , 206 ),<|>Tot Used: 541 , Added: 1 , Zero Std: 0 , Max Cor: 0.899
#>
43 <R=0.899,thr=0.800,N= 84>, Top: 37( 1 )=( 1 )[ 2 : 37 Fa= 218 : 0.843 ]( 36 , 43 , 206 ),<|>Tot Used: 558 , Added: 43 , Zero Std: 0 , Max Cor: 0.903
#>
44 <R=0.903,thr=0.900,N= 2>, Top: 1( 1 )[ 1 : 1 Fa= 218 : 0.900 ]( 1 , 1 , 218 ),<|>Tot Used: 558 , Added: 1 , Zero Std: 0 , Max Cor: 0.877
#>
45 <R=0.877,thr=0.800,N= 15>, Top: 7( 1 )[ 1 : 7 Fa= 222 : 0.800 ]( 7 , 8 , 218 ),<|>Tot Used: 558 , Added: 8 , Zero Std: 0 , Max Cor: 0.964
#>
46 <R=0.964,thr=0.900,N= 2>, Top: 1( 1 )[ 1 : 1 Fa= 222 : 0.900 ]( 1 , 1 , 222 ),<|>Tot Used: 558 , Added: 1 , Zero Std: 0 , Max Cor: 0.798
#>
47 <R=0.798,thr=0.800,N= 0>
#>
[ 47 ], 0.7984858 Decor Dimension: 558 Nused: 558 . Cor to Base: 331 , ABase: 34 , Outcome Base: 0
#>
varlistc <- colnames(DEdataframe)[colnames(DEdataframe) != outcome]
pander::pander(sum(apply(dataframe[,varlist],2,var)))
6.77e+22
pander::pander(sum(apply(DEdataframe[,varlistc],2,var)))
6.77e+22
pander::pander(entropy(discretize(unlist(dataframe[,varlist]), 256)))
0.000131
pander::pander(entropy(discretize(unlist(DEdataframe[,varlistc]), 256)))
0.000131
if (!largeSet)
{
par(cex=0.6,cex.main=0.85,cex.axis=0.7)
UPLTM <- attr(DEdataframe,"UPLTM")
gplots::heatmap.2(1.0*(abs(UPLTM)>0),
trace = "none",
mar = c(5,5),
col=rev(heat.colors(5)),
main = "Decorrelation matrix",
cexRow = cexheat,
cexCol = cexheat,
srtCol=45,
srtRow=45,
key.title=NA,
key.xlab="|Beta|>0",
xlab="Output Feature", ylab="Input Feature")
par(op)
}
if (!largeSet)
{
cormat <- cor(DEdataframe[,varlistc],method="pearson")
cormat[is.na(cormat)] <- 0
gplots::heatmap.2(abs(cormat),
trace = "none",
mar = c(5,5),
col=rev(heat.colors(5)),
main = "Correlation after IDeA",
cexRow = cexheat,
cexCol = cexheat,
srtCol=45,
srtRow=45,
key.title=NA,
key.xlab="|Pearson Correlation|",
xlab="Feature", ylab="Feature")
par(op)
diag(cormat) <- 0
print(max(abs(cormat)))
}
[1]
0.7984858
if (nrow(dataframe) < 1000)
{
classes <- unique(dataframe[1:numsub,outcome])
raincolors <- rainbow(length(classes))
names(raincolors) <- classes
datasetframe.umap = umap(scale(dataframe[1:numsub,varlist]),n_components=2)
plot(datasetframe.umap$layout,xlab="U1",ylab="U2",main="UMAP: Original",t='n')
text(datasetframe.umap$layout,labels=dataframe[1:numsub,outcome],col=raincolors[dataframe[1:numsub,outcome]+1])
}
if (nrow(dataframe) < 1000)
{
datasetframe.umap = umap(scale(DEdataframe[1:numsub,varlistc]),n_components=2)
plot(datasetframe.umap$layout,xlab="U1",ylab="U2",main="UMAP: After IDeA",t='n')
text(datasetframe.umap$layout,labels=DEdataframe[1:numsub,outcome],col=raincolors[DEdataframe[1:numsub,outcome]+1])
}
univarRAW <- uniRankVar(varlist,
paste(outcome,"~1"),
outcome,
dataframe,
rankingTest="AUC")
100 : wavelet.HHH_firstorder_10Percentile 200 :
wavelet.HHL_firstorder_Uniformity 300 : wavelet.HLH_glcm_Imc1 400 :
wavelet.HLL_gldm_GrayLevelVariance 500 :
wavelet.LHH_glrlm_LongRunLowGrayLevelEmphasis
600 : wavelet.LHL_glszm_LargeAreaHighGrayLevelEmphasis
univarDe <- uniRankVar(varlistc,
paste(outcome,"~1"),
outcome,
DEdataframe,
rankingTest="AUC",
)
100 : La_wavelet.HHH_firstorder_10Percentile 200 :
La_wavelet.HHL_firstorder_Uniformity 300 : La_wavelet.HLH_glcm_Imc1 400
: La_wavelet.HLL_gldm_GrayLevelVariance 500 :
La_wavelet.LHH_glrlm_LongRunLowGrayLevelEmphasis
600 : La_wavelet.LHL_glszm_LargeAreaHighGrayLevelEmphasis
univariate_columns <- c("caseMean","caseStd","controlMean","controlStd","controlKSP","ROCAUC")
##top variables
topvar <- c(1:length(varlist)) <= TopVariables
tableRaw <- univarRAW$orderframe[topvar,univariate_columns]
pander::pander(tableRaw)
| caseMean | caseStd | controlMean | controlStd | controlKSP | ROCAUC | |
|---|---|---|---|---|---|---|
| original_firstorder_Skewness | -3.93e-02 | 5.28e-01 | -6.84e-01 | 6.34e-01 | 9.78e-01 | 0.780 |
| original_glcm_ClusterShade | 7.42e+02 | 1.02e+04 | -1.06e+04 | 1.65e+04 | 4.41e-02 | 0.755 |
| wavelet.HLL_glcm_ClusterShade | -7.99e+02 | 3.12e+03 | 2.32e+03 | 4.29e+03 | 4.72e-02 | 0.737 |
| wavelet.HLL_firstorder_Skewness | -1.05e-02 | 5.50e-01 | 5.21e-01 | 8.55e-01 | 5.54e-02 | 0.736 |
| original_firstorder_Median | 2.77e+02 | 5.52e+01 | 3.33e+02 | 8.63e+01 | 6.29e-01 | 0.732 |
| original_glcm_MaximumProbability | 6.19e-03 | 2.32e-03 | 1.02e-02 | 6.26e-03 | 7.10e-02 | 0.722 |
| original_gldm_LargeDependenceHighGrayLevelEmphasis | 1.36e+04 | 9.87e+03 | 3.19e+04 | 3.44e+04 | 2.54e-03 | 0.711 |
| original_glcm_JointEnergy | 1.72e-03 | 7.60e-04 | 2.89e-03 | 2.23e-03 | 1.21e-02 | 0.710 |
| original_firstorder_Mean | 2.75e+02 | 5.33e+01 | 3.20e+02 | 7.86e+01 | 3.40e-01 | 0.702 |
| original_glszm_LargeAreaHighGrayLevelEmphasis | 2.34e+04 | 4.63e+04 | 1.77e+05 | 7.31e+05 | 1.50e-08 | 0.700 |
topLAvar <- univarDe$orderframe$Name[str_detect(univarDe$orderframe$Name,"La_")]
topLAvar <- unique(c(univarDe$orderframe$Name[topvar],topLAvar[1:as.integer(TopVariables/2)]))
finalTable <- univarDe$orderframe[topLAvar,univariate_columns]
pander::pander(finalTable)
| caseMean | caseStd | controlMean | controlStd | controlKSP | ROCAUC | |
|---|---|---|---|---|---|---|
| original_firstorder_Skewness | -0.0393 | 5.28e-01 | -6.84e-01 | 6.34e-01 | 0.9782 | 0.780 |
| La_wavelet.HLL_glszm_GrayLevelNonUniformity | 7.1674 | 4.96e+00 | 2.66e+00 | 4.85e+00 | 0.2308 | 0.763 |
| La_wavelet.LHL_glszm_GrayLevelNonUniformity | 7.7946 | 5.30e+00 | 3.74e+00 | 4.16e+00 | 0.6544 | 0.759 |
| original_glcm_ClusterShade | 741.5044 | 1.02e+04 | -1.06e+04 | 1.65e+04 | 0.0441 | 0.755 |
| La_original_firstorder_Entropy | 4.5227 | 1.36e-01 | 4.34e+00 | 2.53e-01 | 0.4823 | 0.752 |
| La_original_glcm_Idn | -1.3451 | 3.62e-03 | -1.34e+00 | 7.00e-03 | 0.9888 | 0.748 |
| La_wavelet.LHH_glcm_InverseVariance | 0.4973 | 2.04e-02 | 5.18e-01 | 2.76e-02 | 0.6941 | 0.738 |
| wavelet.HLL_glcm_ClusterShade | -799.0582 | 3.12e+03 | 2.32e+03 | 4.29e+03 | 0.0472 | 0.737 |
| wavelet.HLL_firstorder_Skewness | -0.0105 | 5.50e-01 | 5.21e-01 | 8.55e-01 | 0.0554 | 0.736 |
| La_wavelet.HLL_gldm_HighGrayLevelEmphasis | -23.1086 | 3.90e+01 | -6.66e+01 | 6.62e+01 | 0.3168 | 0.731 |
dc <- getLatentCoefficients(DEdataframe)
fscores <- attr(DEdataframe,"fscore")
pander::pander(c(mean=mean(sapply(dc,length)),total=length(dc),fraction=length(dc)/(ncol(dataframe)-1)))
| mean | total | fraction |
|---|---|---|
| 2.68 | 495 | 0.782 |
theCharformulas <- attr(dc,"LatentCharFormulas")
finalTable <- rbind(finalTable,tableRaw[topvar[!(topvar %in% topLAvar)],univariate_columns])
orgnamez <- rownames(finalTable)
orgnamez <- str_remove_all(orgnamez,"La_")
finalTable$RAWAUC <- univarRAW$orderframe[orgnamez,"ROCAUC"]
finalTable$DecorFormula <- theCharformulas[rownames(finalTable)]
finalTable$fscores <- fscores[rownames(finalTable)]
Final_Columns <- c("DecorFormula","caseMean","caseStd","controlMean","controlStd","controlKSP","ROCAUC","RAWAUC","fscores")
finalTable <- finalTable[order(-finalTable$ROCAUC),]
pander::pander(finalTable[,Final_Columns])
| DecorFormula | caseMean | caseStd | controlMean | controlStd | controlKSP | ROCAUC | RAWAUC | fscores | |
|---|---|---|---|---|---|---|---|---|---|
| original_firstorder_Skewness | NA | -3.93e-02 | 5.28e-01 | -6.84e-01 | 6.34e-01 | 9.78e-01 | 0.780 | 0.780 | NA |
| original_firstorder_Skewness1 | NA | -3.93e-02 | 5.28e-01 | -6.84e-01 | 6.34e-01 | 9.78e-01 | 0.780 | NA | NA |
| La_wavelet.HLL_glszm_GrayLevelNonUniformity | - (1.55e-03)original_shape_MeshVolume + wavelet.HLL_glszm_GrayLevelNonUniformity | 7.17e+00 | 4.96e+00 | 2.66e+00 | 4.85e+00 | 2.31e-01 | 0.763 | 0.613 | -1 |
| La_wavelet.LHL_glszm_GrayLevelNonUniformity | - (1.58e-03)original_shape_MeshVolume + wavelet.LHL_glszm_GrayLevelNonUniformity | 7.79e+00 | 5.30e+00 | 3.74e+00 | 4.16e+00 | 6.54e-01 | 0.759 | 0.607 | -1 |
| original_glcm_ClusterShade | NA | 7.42e+02 | 1.02e+04 | -1.06e+04 | 1.65e+04 | 4.41e-02 | 0.755 | 0.755 | NA |
| original_glcm_ClusterShade1 | NA | 7.42e+02 | 1.02e+04 | -1.06e+04 | 1.65e+04 | 4.41e-02 | 0.755 | NA | NA |
| La_original_firstorder_Entropy | + original_firstorder_Entropy - (0.020)original_firstorder_MeanAbsoluteDeviation | 4.52e+00 | 1.36e-01 | 4.34e+00 | 2.53e-01 | 4.82e-01 | 0.752 | 0.595 | 4 |
| La_original_glcm_Idn | - (2.301)original_glcm_Idmn + original_glcm_Idn | -1.35e+00 | 3.62e-03 | -1.34e+00 | 7.00e-03 | 9.89e-01 | 0.748 | 0.542 | -1 |
| La_wavelet.LHH_glcm_InverseVariance | + (0.016)wavelet.LHH_firstorder_MeanAbsoluteDeviation + wavelet.LHH_glcm_InverseVariance | 4.97e-01 | 2.04e-02 | 5.18e-01 | 2.76e-02 | 6.94e-01 | 0.738 | 0.573 | -1 |
| wavelet.HLL_glcm_ClusterShade | NA | -7.99e+02 | 3.12e+03 | 2.32e+03 | 4.29e+03 | 4.72e-02 | 0.737 | 0.737 | NA |
| wavelet.HLL_glcm_ClusterShade1 | NA | -7.99e+02 | 3.12e+03 | 2.32e+03 | 4.29e+03 | 4.72e-02 | 0.737 | NA | NA |
| wavelet.HLL_firstorder_Skewness | NA | -1.05e-02 | 5.50e-01 | 5.21e-01 | 8.55e-01 | 5.54e-02 | 0.736 | 0.736 | NA |
| wavelet.HLL_firstorder_Skewness1 | NA | -1.05e-02 | 5.50e-01 | 5.21e-01 | 8.55e-01 | 5.54e-02 | 0.736 | NA | NA |
| original_firstorder_Median | NA | 2.77e+02 | 5.52e+01 | 3.33e+02 | 8.63e+01 | 6.29e-01 | 0.732 | 0.732 | NA |
| La_wavelet.HLL_gldm_HighGrayLevelEmphasis | + wavelet.HLL_gldm_HighGrayLevelEmphasis - (0.996)wavelet.HLL_glszm_HighGrayLevelZoneEmphasis | -2.31e+01 | 3.90e+01 | -6.66e+01 | 6.62e+01 | 3.17e-01 | 0.731 | 0.503 | 1 |
| original_glcm_MaximumProbability | NA | 6.19e-03 | 2.32e-03 | 1.02e-02 | 6.26e-03 | 7.10e-02 | 0.722 | 0.722 | NA |
| original_gldm_LargeDependenceHighGrayLevelEmphasis | NA | 1.36e+04 | 9.87e+03 | 3.19e+04 | 3.44e+04 | 2.54e-03 | 0.711 | 0.711 | NA |
| original_glcm_JointEnergy | NA | 1.72e-03 | 7.60e-04 | 2.89e-03 | 2.23e-03 | 1.21e-02 | 0.710 | 0.710 | 2 |
| original_firstorder_Mean | NA | 2.75e+02 | 5.33e+01 | 3.20e+02 | 7.86e+01 | 3.40e-01 | 0.702 | 0.702 | 5 |
| original_glszm_LargeAreaHighGrayLevelEmphasis | NA | 2.34e+04 | 4.63e+04 | 1.77e+05 | 7.31e+05 | 1.50e-08 | 0.700 | 0.700 | NA |
featuresnames <- colnames(dataframe)[colnames(dataframe) != outcome]
pc <- prcomp(dataframe[,iscontinous],center = TRUE,scale. = TRUE) #principal components
predPCA <- predict(pc,dataframe[,iscontinous])
PCAdataframe <- as.data.frame(cbind(predPCA,dataframe[,!iscontinous]))
colnames(PCAdataframe) <- c(colnames(predPCA),colnames(dataframe)[!iscontinous])
#plot(PCAdataframe[,colnames(PCAdataframe)!=outcome],col=dataframe[,outcome],cex=0.65,cex.lab=0.5,cex.axis=0.75,cex.sub=0.5,cex.main=0.75)
#pander::pander(pc$rotation)
PCACor <- cor(PCAdataframe[,colnames(PCAdataframe) != outcome])
gplots::heatmap.2(abs(PCACor),
trace = "none",
# scale = "row",
mar = c(5,5),
col=rev(heat.colors(5)),
main = "PCA Correlation",
cexRow = 0.5,
cexCol = 0.5,
srtCol=45,
srtRow= -45,
key.title=NA,
key.xlab="Pearson Correlation",
xlab="Feature", ylab="Feature")
EFAdataframe <- dataframeScaled
if (length(iscontinous) < 2000)
{
topred <- min(length(iscontinous),nrow(dataframeScaled),ncol(predPCA)/2)
if (topred < 2) topred <- 2
uls <- fa(dataframeScaled[,iscontinous],nfactors=topred,rotate="varimax",warnings=FALSE) # EFA analysis
predEFA <- predict(uls,dataframeScaled[,iscontinous])
EFAdataframe <- as.data.frame(cbind(predEFA,dataframeScaled[,!iscontinous]))
colnames(EFAdataframe) <- c(colnames(predEFA),colnames(dataframeScaled)[!iscontinous])
EFACor <- cor(EFAdataframe[,colnames(EFAdataframe) != outcome])
gplots::heatmap.2(abs(EFACor),
trace = "none",
# scale = "row",
mar = c(5,5),
col=rev(heat.colors(5)),
main = "EFA Correlation",
cexRow = 0.5,
cexCol = 0.5,
srtCol=45,
srtRow= -45,
key.title=NA,
key.xlab="Pearson Correlation",
xlab="Feature", ylab="Feature")
}
par(op)
par(xpd = TRUE)
dataframe[,outcome] <- factor(dataframe[,outcome])
rawmodel <- rpart(paste(outcome,"~."),dataframe,control=rpart.control(maxdepth=3))
pr <- predict(rawmodel,dataframe,type = "class")
ptab <- list(er="Error",detail=matrix(nrow=6,ncol=1))
if (length(unique(pr))>1)
{
plot(rawmodel,main="Raw",branch=0.5,uniform = TRUE,compress = TRUE,margin=0.1)
text(rawmodel, use.n = TRUE,cex=0.75)
ptab <- epiR::epi.tests(table(pr==0,dataframe[,outcome]==0))
}
pander::pander(table(dataframe[,outcome],pr))
| 0 | 1 | |
|---|---|---|
| 0 | 46 | 8 |
| 1 | 9 | 87 |
pander::pander(ptab$detail[c(5,3,4,6),])
| statistic | est | lower | upper | |
|---|---|---|---|---|
| 5 | diag.ac | 0.887 | 0.825 | 0.933 |
| 3 | se | 0.906 | 0.829 | 0.956 |
| 4 | sp | 0.852 | 0.729 | 0.934 |
| 6 | diag.or | 55.583 | 20.099 | 153.711 |
par(op)
par(xpd = TRUE)
DEdataframe[,outcome] <- factor(DEdataframe[,outcome])
IDeAmodel <- rpart(paste(outcome,"~."),DEdataframe,control=rpart.control(maxdepth=3))
pr <- predict(IDeAmodel,DEdataframe,type = "class")
ptab <- list(er="Error",detail=matrix(nrow=6,ncol=1))
if (length(unique(pr))>1)
{
plot(IDeAmodel,main="IDeA",branch=0.5,uniform = TRUE,compress = TRUE,margin=0.1)
text(IDeAmodel, use.n = TRUE,cex=0.75)
ptab <- epiR::epi.tests(table(pr==0,DEdataframe[,outcome]==0))
}
pander::pander(table(DEdataframe[,outcome],pr))
| 0 | 1 | |
|---|---|---|
| 0 | 44 | 10 |
| 1 | 10 | 86 |
pander::pander(ptab$detail[c(5,3,4,6),])
| statistic | est | lower | upper | |
|---|---|---|---|---|
| 5 | diag.ac | 0.867 | 0.802 | 0.917 |
| 3 | se | 0.896 | 0.817 | 0.949 |
| 4 | sp | 0.815 | 0.686 | 0.907 |
| 6 | diag.or | 37.840 | 14.652 | 97.728 |
par(op)
par(xpd = TRUE)
PCAdataframe[,outcome] <- factor(PCAdataframe[,outcome])
PCAmodel <- rpart(paste(outcome,"~."),PCAdataframe,control=rpart.control(maxdepth=3))
pr <- predict(PCAmodel,PCAdataframe,type = "class")
ptab <- list(er="Error",detail=matrix(nrow=6,ncol=1))
if (length(unique(pr))>1)
{
plot(PCAmodel,main="PCA",branch=0.5,uniform = TRUE,compress = TRUE,margin=0.1)
text(PCAmodel, use.n = TRUE,cex=0.75)
ptab <- epiR::epi.tests(table(pr==0,PCAdataframe[,outcome]==0))
}
pander::pander(table(PCAdataframe[,outcome],pr))
| 0 | 1 | |
|---|---|---|
| 0 | 38 | 16 |
| 1 | 14 | 82 |
pander::pander(ptab$detail[c(5,3,4,6),])
| statistic | est | lower | upper | |
|---|---|---|---|---|
| 5 | diag.ac | 0.800 | 0.727 | 0.861 |
| 3 | se | 0.854 | 0.767 | 0.918 |
| 4 | sp | 0.704 | 0.564 | 0.820 |
| 6 | diag.or | 13.911 | 6.164 | 31.392 |
par(op)
EFAdataframe[,outcome] <- factor(EFAdataframe[,outcome])
EFAmodel <- rpart(paste(outcome,"~."),EFAdataframe,control=rpart.control(maxdepth=3))
pr <- predict(EFAmodel,EFAdataframe,type = "class")
ptab <- list(er="Error",detail=matrix(nrow=6,ncol=1))
if (length(unique(pr))>1)
{
plot(EFAmodel,main="EFA",branch=0.5,uniform = TRUE,compress = TRUE,margin=0.1)
text(EFAmodel, use.n = TRUE,cex=0.75)
ptab <- epiR::epi.tests(table(pr==0,EFAdataframe[,outcome]==0))
}
pander::pander(table(EFAdataframe[,outcome],pr))
| 0 | 1 | |
|---|---|---|
| 0 | 42 | 12 |
| 1 | 7 | 89 |
pander::pander(ptab$detail[c(5,3,4,6),])
| statistic | est | lower | upper | |
|---|---|---|---|---|
| 5 | diag.ac | 0.873 | 0.809 | 0.922 |
| 3 | se | 0.927 | 0.856 | 0.970 |
| 4 | sp | 0.778 | 0.644 | 0.880 |
| 6 | diag.or | 44.500 | 16.342 | 121.177 |
par(op)